home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / Dylan Related / Mindy / Mindy 1.2 - Mac PPC / demos / debug / dylan-test.dylan < prev    next >
Encoding:
Text File  |  1995-03-15  |  22.8 KB  |  524 lines  |  [TEXT/MMCC]
  1. Module: dylan-test
  2. author: Roger Critchlow (rec@elf.org)
  3. synopsis: A regression test for core Dylan.
  4.  
  5. //======================================================================
  6. //
  7. // Copyright (c) 1994  Carnegie Mellon University
  8. // All rights reserved.
  9. // 
  10. // Use and copying of this software and preparation of derivative
  11. // works based on this software are permitted, including commercial
  12. // use, provided that the following conditions are observed:
  13. // 
  14. // 1. This copyright notice must be retained in full on any copies
  15. //    and on appropriate parts of any derivative works.
  16. // 2. Documentation (paper or online) accompanying any system that
  17. //    incorporates this software, or any part of it, must acknowledge
  18. //    the contribution of the Gwydion Project at Carnegie Mellon
  19. //    University.
  20. // 
  21. // This software is made available "as is".  Neither the authors nor
  22. // Carnegie Mellon University make any warranty about the software,
  23. // its performance, or its conformity to any specification.
  24. // 
  25. // Bug reports, questions, comments, and suggestions should be sent by
  26. // E-mail to the Internet address "gwydion-bugs@cs.cmu.edu".
  27. //
  28. //======================================================================
  29. //
  30. // This program runs a set of simple minded tests past the compiler
  31. // and interpreter.  Lots more tests could be added, obviously, but
  32. // even these few have turned up some problems.  A large block are copied
  33. // from the DIRM examples.
  34. //
  35.  
  36. define module dylan-test
  37.   use Dylan;
  38.   use Extensions;
  39.   use Cheap-IO;
  40. end;
  41.  
  42. define constant buggy? = #f;        // not bugs, features!
  43.  
  44. define constant tautologies =
  45.   #(#"booleans",
  46.     #"comparisons",
  47.     #"numbers",
  48.     #"characters",
  49.     #"symbols",
  50.     #"collections",
  51.     #"sequences",
  52.     #"arrays",
  53.     #"deques",
  54.     #"lists",
  55.     #"ranges",
  56.     #"stretchy vectors",
  57.     #"strings",
  58.     #"tables",
  59.     #"vectors");
  60.  
  61. define method tautology(arg == #"booleans")
  62.   (#t)                | signal("#t is not true!\n");
  63.   (#T)                | signal("#T is not true!\n");
  64.   (#f)                & signal("#f is not false!\n");
  65.   (#F)                & signal("#F is not false!\n");
  66.   (#t & #t)            | signal("#t & #t is not true!\n");
  67.   (#t | #t)            | signal("#t | #t is not true!\n");
  68.   (#f & #f)            & signal("#f & #f is not false!\n");
  69.   (#f | #f)            & signal("#f | #f is not false!\n");
  70.   (#t & #f)            & signal("#t & #f is not false!\n");
  71.   (#t | #f)            | signal("#t | #f is not true!\n");
  72.   (#f & #t)            & signal("#f & #t is not false!\n");
  73.   (#f | #t)            | signal("#f | #t is not true!\n");
  74. end method;
  75.  
  76. define method tautology(arg == #"comparisons")
  77.   (1 = 1)            | signal("1 is not equal to 1!\n");
  78.   (1 == 1)            | signal("1 is not really equal to 1!\n");
  79.   (1 ~= 1)            & signal("1 is not equal to 1!\n");
  80.   (1 < 2)            | signal("1 is not less than 2!\n");
  81.   (1 >= 2)            & signal("1 is greater than or equal to 2!\n");
  82.   (1 <= 2)            | signal("1 is not less than or equal to 2!\n");
  83.   (1 > 2)            & signal("1 is greater than 2!\n");
  84.   ('a' < 'b')            | signal("'a' is greater than 'b'!\n");
  85.   ("A" < "B")            | signal("\"A\" is greater than \"B\"!\n");
  86. end method;
  87.  
  88. define method tautology(arg == #"numbers")
  89.   instance?(1, <number>)        | signal("1 is not a <number>");
  90.   instance?(1, <real>)            | signal("1 is not a <real>!\n");
  91.   instance?(1, <float>)            & signal("1 is a <float>!\n");
  92.   instance?(1, <single-float>)        & signal("1 is a <single-float>!\n");
  93.   instance?(1, <double-float>)        & signal("1 is a <double-float>!\n");
  94.   instance?(1, <extended-float>)    & signal("1 is a <extended-float>!\n");
  95.   instance?(1, <rational>)        | signal("1 is not a <rational>!\n");
  96.   instance?(1, <integer>)        | signal("1 is not a <integer>!\n");
  97.   instance?(1, <complex>)        | signal("1 is not a <complex>!\n");
  98.   instance?(1.0, <number>)        | signal("1.0 is not a <number>");
  99.   instance?(1.0, <real>)        | signal("1.0 is not a <real>!\n");
  100.   instance?(1.0, <float>)        | signal("1.0 is not a <float>!\n");
  101.   instance?(1.0s0, <single-float>)    | signal("1.0s0 is not a <single-float>!\n");
  102.   instance?(1.0d0, <double-float>)    | signal("1.0d0 is not a <double-float>!\n");
  103.   instance?(1.0x0, <extended-float>)    | signal("1.0x0 is not a <extended-float>!\n");
  104.   instance?(1.0, <rational>)        & signal("1.0 is a <rational>!\n");
  105.   instance?(1.0, <integer>)        & signal("1.0 is a <integer>!\n");
  106.   instance?(1.0, <complex>)        | signal("1.0 is not a <complex>!\n");
  107.   odd?(1)                | signal("1 is not odd!\n");
  108.   even?(2)                | signal("2 is not even!\n");
  109.   zero?(0)                | signal("0 is not zero!\n");
  110.   positive?(+1)                | signal("+1 is not positive!\n");
  111.   negative?(-1)                | signal("-1 is not negative!\n");
  112.   integral?(+1)                | signal("+1 is not integral!\n");
  113.   integral?(0)                | signal("0 is not integral!\n");
  114.   integral?(-1)             | signal("-1 is not integral!\n");
  115.   (1 + 1 = 2)                | signal("1 + 1 is not 2!\n");
  116.   (2 * 2 = 4)                | signal("2 * 2 is not 4!\n");
  117.   (1 - 1 = 0)                | signal("1 - 1 is not 0!\n");
  118.   (4.0 / 2.0 = 2.0)            | signal("4 / 2 is not 2!\n");
  119.   (negative(1) = -1)            | signal("negative(1) is not -1!\n");
  120.   (floor(3.14) = 3)            | signal("floor(3.14) is not 3\n");
  121.   (ceiling(3.14) = 4)            | signal("ceiling(3.14) is not 4!\n");
  122.   (round(3.14) = 3)            | signal("round(3.14) is not 3!\n");
  123.   (truncate(3.14) = 3)            | signal("truncate(3.14) is not 3!\n");
  124.   //floor/
  125.   //ceiling/
  126.   //round/
  127.   //truncate/
  128.   //modulo
  129.   //remainder
  130.   (abs(1) = 1)                | signal("abs(1) is not 1!: it's %=\n", abs(1));
  131.   (abs(-1) = 1)                | signal("abs(-1) is not 1!: it's %=\n", abs(-1));
  132.   (logior(1,2) = 3)            | signal("logior(1,2) is not 3!: it's %=\n", logior(1,2));
  133.   (logxor(1,3) = 2)            | signal("logxor(1,3) is not 2!: it's %=\n", logxor(1,3));
  134.   (logand(1,3) = 1)            | signal("logand(1,3) is not 1!: it's %=\n", logand(1,3));
  135.   (lognot(#x1234) = #xffffedcb)        | signal("lognot(#x1234) is not #xffffedcb!: it's %x\n", lognot(#x1234));
  136.   logbit?(15,#x8000)             | signal("logbit?(15,#x8000) is not true!\n");
  137.   (ash(1,3) = 8)            | signal("ash(1,3) is not 8!: it's %=\n", ash(1,3));
  138.   (lcm(6,8) = 24)            | signal("lcm(6,8) is not 24!: it's %=\n", lcm(6,8));
  139.   (gcd(6,8) = 2)            | signal("gcd(6,8) is not 2!: it's %=\n", gcd(6,8));
  140.   (min(1,2) = 1)            | signal("min(1,2) is not 1!: it's %=\n", min(1,2));
  141.   (max(1,2) = 2)            | signal("max(1,2) is not 2!: it's %=\n", max(1,2));
  142.   if (buggy?)
  143.     // NB - rationals may not be part of the language
  144.     instance?(1, <ratio>)
  145.       | signal("1 is not a <ratio>!\n");
  146.     // Unbound variable: <ratio>
  147.     instance?(1.0, <ratio>)
  148.       & signal("1.0 is a <ratio>!\n");
  149.     // Unbound variable: <ratio>
  150.     (4 / 2 = 2)
  151.       | signal("4 / 2 is not 2!\n");
  152.     // No applicable methods for / with arguments #[4, 2]
  153. //    format("rationalize(1,2) is %=\n", rationalize(1,2));
  154.     // Unbound variable: rationalize
  155. //    format("numerator(rationalize(1,2)) is %=\n", numerator(rationalize(1,2)));
  156.     // Unbound variable: numerator
  157. //    format("denominator(rationalize(1,2)) is %=\n", denominator(rationalize(1,2)));
  158.     // Unbound variable: denominator
  159.   end;
  160. end method;
  161.  
  162. define method tautology(arg == #"characters")
  163.   instance?('a', <character>)        | signal("'a' is not a <character>!\n");
  164.   (as-uppercase('a') = 'A')        | signal("as-uppercase('a') is not 'A'!\n");
  165.   (as-lowercase('A') = 'a')        | signal("as-lowercase('A') is not 'a'!\n");
  166.   (as(<integer>, ' ') = 32)        | signal("as(<integer>, ' ') is not 32!\n");
  167.   (as(<character>, 32) = ' ')        | signal("as(<character>, 32) is not ' '!\n");
  168. end method;
  169.  
  170. define method tautology(arg == #"symbols")
  171.   instance?(#"foo", <symbol>)        | signal("instance?(#\"foo\", <symbol>) is false!\n");
  172.   instance?(#"foo", <symbol>)        | signal("instance?(foo:, <symbol>) is false!\n");
  173.   (#"foo" = #"FOO")            | signal("#\"foo\" is not FOO:!\n");
  174.   (as(<symbol>, "FOO") = #"foo")    | signal("as(<symbol>, \"FOO\") is not foo:!\n");
  175.   (as(<string>, #"Foo") = "foo")    | signal("as(<string>, Foo:) is not \"foo\"! It's %=\n",
  176.                          as(<string>, Foo:));
  177. end method;
  178.  
  179. define method tautology(arg == #"collections")
  180.   (size(#()) = 0)
  181.     | signal("size(#()) is not zero!\n");
  182.   (size(#[]) = 0)
  183.     | signal("size(#[]) is not zero!\n");
  184.   empty?(#())
  185.     | signal("#() is not empty!\n");
  186.   empty?(#[])
  187.     | signal("#[] is not empty!\n");
  188.   (size(list()) == 0)
  189.     | signal("size(list()) is not zero!\n");
  190.   (size(vector()) == 0)
  191.     | signal("size(vector()) is not zero!\n");
  192.   empty?(list())
  193.     | signal("list() is not empty!\n");
  194.   empty?(vector())
  195.     | signal("vector() is not empty!\n");
  196.   do(\+, #(1,2), #(3, 2))
  197.     & signal("do returned #t!\n");
  198.   (map(\+, #(100, 100, 200, 200), #(1, 2, 3, 4)) = #(101, 102, 203, 204))
  199.     | signal("map(\\+, #(100, 100, 200, 200), #(1, 2, 3, 4)) is not #(101, 102, 203, 204)! It's %=\n",
  200.          map(\+, #(100, 100, 200, 200), #(1, 2, 3, 4)));
  201.   (map(\+, #(1,2), #(3,2)) = #(4,4))
  202.     | signal("map(\\+, #(1,2), #(3,2)) is not equal to #(4,4)! It's %=\n",
  203.          map(\+, #(1,2), #(3,2)));
  204.   (map-as(<vector>, \+, #(1,2), #(3,2)) = #[4,4])
  205.     | signal("map-as(<vector>, \\+, #(1,2), #(3,2)) is not equal to #[4,4]! It's %=\n",
  206.          map-as(<vector>, \+, #(1,2), #(3,2)));
  207.   // NB - the DIRM example for map-into is in error.
  208.   let x = list(100, 100, 200, 200);
  209.   (map-into(x, \+, #(100, 100, 200, 200), #(1, 2, 3, 4)) = #(101, 102, 203, 204))
  210.     | signal("map-into (x, \\+, #(100, 100, 200, 200), #(1, 2, 3, 4)) is not equal to #(101, 102, 203, 204)! It's %=\n",
  211.          map-into (x, \+, x, #(1, 2, 3, 4)));
  212.   (x = #(101, 102, 203, 204))
  213.     | signal("map-into'ed x is not equal to #(101, 102, 203, 204)! It's %=\n", x);
  214.   any?(\>, #(1,2,3,4), #(5,4,3,2))
  215.     | signal("any?(\\>, #(1,2,3,4), #(5,4,3,2)) is not true!\n");
  216.   any?(even?, #(1, 3, 5, 7))
  217.     & signal("any?(even?, #(1, 3, 5, 7)) is not false!\n");
  218.   every?(\>, #(1,2,3,4), #(5,4,3,2))
  219.     & signal("every?(\\>, #(1,2,3,4), #(5,4,3,2)) is true!\n");
  220.   every? (odd?, #(1, 3, 5, 7))
  221.     | signal("every? (odd?, #(1, 3, 5, 7)) is false!\n");
  222.   let high-score = 10;
  223.   (reduce (max, high-score, #(3, 1, 4, 1, 5, 9)) = 10)
  224.     | signal("reduce(max, high-score, #(3, 1, 4, 1, 5, 9)) is not 10! It's %=\n",
  225.          reduce(max, high-score, #(3, 1, 4, 1, 5, 9)));
  226.   (reduce(max, high-score, #(3, 12, 9, 8, 8, 6)) = 12)
  227.     | signal(" reduce(max, high-score, #(3, 12, 9, 8, 8, 6)) is not 12! It's %=\n",
  228.          reduce(max, high-score, #(3, 12, 9, 8, 8, 6)));
  229.   (reduce1(\+, #(1, 2, 3, 4, 5)) = 15)
  230.     | signal("reduce1(\\+, #(1, 2, 3, 4, 5)) is not 15! It's %=\n",
  231.          reduce1(\+, #(1, 2, 3, 4, 5)));
  232.   let flavors = #(#"vanilla", #"pistachio", #"ginger");
  233.   member?(#"vanilla", flavors)
  234.     | signal("member?(#\"vanilla\", flavors) is false!\n");
  235.   member?(#"banana", flavors)
  236.     & signal("member?(#\"banana\", flavors) is true!\n");
  237.   local method has-nuts?(flavor) member?(flavor, #(#"pistachio")) end;
  238.   (find-key(flavors, has-nuts?) = 1)
  239.     | signal("find-key(flavors, has-nuts?) is not 1! It's %=\n",
  240.        find-key(flavors, has-nuts?));
  241.   local method double(n) 2 * n end;
  242.   let numbers = list (10, 13, 16, 19);
  243.   (replace-elements!(numbers, odd?, double) = #(10, 26, 16, 38))
  244.     | signal("replace-elements!(numbers, odd?, double) is not #(10, 26, 16, 38)! It's %=\n",
  245.          replace-elements!(numbers, odd?, double));
  246.   (fill!(numbers, 3, start: 2) = #(10, 26, 3, 3))
  247.     | signal("fill! (numbers, 3, start: 2) is not #(10, 26, 3, 3)!  It's %=\n",
  248.          fill! (numbers, 3, start: 2));
  249.   key-test(list())
  250.     | signal("no key-test for list()!\n");
  251.   key-test(vector())
  252.     | signal("no key-test for vector()!\n");
  253. end method;
  254.  
  255. define method tautology(arg == #"sequences")
  256.   let numbers = #(3, 4, 5);
  257.   (add(numbers, 1) = #(1, 3, 4, 5))
  258.     | signal("add(numbers, 1) is not #(1, 3, 4, 5))!  It's %=\n", add(numbers, 1));
  259.   let numbers = list (3, 4, 5);
  260.   (add!(numbers, 1) = #(1, 3, 4, 5))
  261.     | signal("add!(numbers, 1) is not #(1, 3, 4, 5))!  It's %=\n", add!(numbers, 1));
  262.   (add-new(#(3, 4, 5), 1) = #(1, 3, 4, 5))
  263.     | signal("add-new (#(3, 4, 5), 1) is not #(1, 3, 4, 5)!  It's %=\n", add-new (#(3, 4, 5), 1));
  264.   (add-new(#(3, 4, 5), 4) = #(3, 4, 5))
  265.     | signal("add-new (#(3, 4, 5), 4) is not #(3, 4, 5)!  It's %=\n", add-new (#(3, 4, 5), 4));
  266.   (add-new!(list (3, 4, 5), 1) = #(1, 3, 4, 5))
  267.     | signal("add-new! (list (3, 4, 5), 1) is not #(1, 3, 4, 5)!  It's %=\n", add-new! (list (3, 4, 5), 1));
  268.   (remove(#(3, 1, 4, 1, 5, 9), 1) = #(3, 4, 5, 9))
  269.     | signal("remove (#(3, 1, 4, 1, 5, 9), 1) is not #(3, 4, 5, 9)! It's %=\n", remove (#(3, 1, 4, 1, 5, 9), 1));
  270.   (remove!(list(3, 1, 4, 1, 5, 9), 1) = #(3, 4, 5, 9))
  271.     | signal("remove! (list(3, 1, 4, 1, 5, 9), 1) is not #(3, 4, 5, 9)! It's %=\n", remove! (list(3, 1, 4, 1, 5, 9), 1));
  272.   (choose(even?, #(3, 1, 4, 1, 5, 9)) = #(4))
  273.     | signal("choose (even?, #(3, 1, 4, 1, 5, 9)) is not #(4)!  It's %=\n", choose (even?, #(3, 1, 4, 1, 5, 9)));
  274.   (choose-by(even?, range (from: 1), #("a", "b", "c", "d", "e", "f", "g", "h", "i")) =  #("b", "d", "f", "h"))
  275.     | signal("choose-by(even?, range (from: 1), #(\"a\", \"b\", \"c\", \"d\", \"e\", \"f\", \"g\", \"h\", \"i\")) is %=!\n",
  276.          choose-by(even?, range (from: 1), #("a", "b", "c", "d", "e", "f", "g", "h", "i")));
  277.   let b = #("john", "paul", "george", "ringo");
  278.   let c = #("richard", "george", "edward", "charles");
  279.   (intersection(b, c, test: \=) = #("george"))
  280.     | signal("intersection(b, c, test: \\=) is not #(\"george\")!  It's %=\n", intersection (b, c, test: \=));
  281.   let a = #("butter", "flour", "sugar", "salt", "eggs");
  282.   let b = #("eggs", "butter", "mushrooms", "onions", "salt");
  283.   let c = #("salt", "butter", "flour", "sugar", "eggs", "mushrooms", "onions");
  284.   (sort(union(a, b, test: \=)) = sort(c))
  285.     | signal("union(a, b, test: \\=) is c! It's %=\n", sort(union(a, b, test: \=)));
  286.   let a = #("spam", "eggs", "spam", "sausage", "spam", "spam");
  287.   let b = #("spam", "eggs", "sausage");
  288.   (sort(remove-duplicates(a, test: \=)) = sort(b))
  289.     | signal("remove-duplicates(a, test: \\=) is not b!  It's %=\n", sort(remove-duplicates(a, test: \=)));
  290.   let a = list("spam", "eggs", "spam", "sausage", "spam", "spam");
  291.   (sort(remove-duplicates!(a, test: \=)) = sort(b))
  292.     | signal("remove-duplicates!(a, test: \\=) is not b!  It's %=\n", sort(remove-duplicates!(a, test: \=)));
  293.   let hamlet = #("to", "be", "or", "not", "to", "be");
  294.   (copy-sequence(hamlet) == hamlet)
  295.     & signal("copy-sequence(hamlet) is identical to hamlet!\n");
  296.   (copy-sequence(hamlet, start: 2, end: 4) = #("or", "not"))
  297.     | signal("copy-sequence(hamlet, start: 2, end: 4) is not #(\"or\", \"not\")!  It's %=\n",
  298.          copy-sequence(hamlet, start: 2, end: 4));
  299.   (concatenate-as(<string>, #('n', 'o', 'n'), #('f', 'a', 't')) = "nonfat")
  300.     | signal("concatenate-as(<string>, #('n', 'o', 'n'), #('f', 'a', 't')) is not \"nonfat\"! It's %=\n",
  301.          concatenate-as(<string>, #('n', 'o', 'n'), #('f', 'a', 't')));
  302.   (concatenate("low-", "calorie") = "low-calorie")
  303.     | signal("concatenate(\"low-\", \"calorie\") is not \"low-calorie\"!  It's %=\n",
  304.          concatenate("low-", "calorie"));
  305.   let x = list("a", "b", "c", "d", "e");
  306.   let abcde = replace-subsequence!(x, #("x", "y", "z"), end: 1);
  307.   (abcde = #("x", "y", "z", "b", "c", "d", "e"))
  308.     | signal("abcde is not #(\"x\", \"y\", \"z\", \"b\", \"c\", \"d\", \"e\")!  It's %=\n", abcde);
  309.   let x = #("bim", "bam", "boom");
  310.   (reverse(x) = #("boom", "bam", "bim"))
  311.     | signal("reverse(x) is not #(\"boom\", \"bam\", \"bim\")! It's %=\n", reverse(x));
  312.   let y = reverse!(x);
  313.   (y = #("boom", "bam", "bim"))
  314.     | signal("reverse!(x) is not #(\"boom\", \"bam\", \"bim\")! It's %=\n", y);
  315.   let numbers = #(3, 1, 4, 1, 5, 9);
  316.   (sort(numbers) = #(1, 1, 3, 4, 5, 9))
  317.     | signal("sort(numbers) is not #(1, 1, 3, 4, 5, 9)!  It's %=\n", sort(numbers));
  318.   let y = sort!(numbers);
  319.   (y = #(1, 1, 3, 4, 5, 9))
  320.     | signal("sort!(numbers) is not #(1, 1, 3, 4, 5, 9)!  It's %=\n", y);
  321.   let numbers = #(3, 1, 4, 1, 5, 9);
  322.   (first(numbers) = 3)
  323.     | signal("first(numbers) is not 3!  It's %=\n", first(numbers));
  324.   (second(numbers) = 1)
  325.     | signal("second(numbers) is not 1!  It's %=\n", second(numbers));
  326.   (third(numbers) = 4)
  327.     | signal("third(numbers) is not 4!  It's %=\n", third(numbers));
  328.   (first-setter(1, numbers) = 1)
  329.     | signal("first-setter(1, numbers) is not 1!  It's %=\n", first-setter(1, numbers));
  330.   (second-setter(2, numbers) = 2)
  331.     | signal("second-setter(2, numbers) is not 2!  It's %=\n", second-setter(2, numbers));
  332.   (third-setter(3, numbers) = 3)
  333.     | signal("third-setter(3, numbers) is not 3!  It's %=\n", third-setter(3, numbers));
  334.   (last (#("emperor", "of", "china")) = "china")
  335.     | signal("last (#(\"emperor\", \"of\", \"china\")) is not \"china\"!  It's %=\n",
  336.          last (#("emperor", "of", "china")));
  337.   let my-list = list (1, 2, 3);
  338.   (my-list = #(1, 2, 3))
  339.     | signal("my-list is not #(1, 2, 3)!  It's %=\n", my-list);
  340.   ((last (my-list) := 4) = 4)
  341.     | signal("last(my-list) := 4 is not 4! It's %=\n", (last (my-list) := 4));
  342.   (subsequence-position ("Ralph Waldo Emerson", "Waldo") = 6)
  343.     | signal("subsequence-position (\"Ralph Waldo Emerson\", \"Waldo\") is not 6!  It's %=\n",
  344.          subsequence-position ("Ralph Waldo Emerson", "Waldo"));
  345.   (#(1, 2, 3) = #[1, 2, 3])
  346.     | signal("#(1, 2, 3) is not equal to #[1, 2, 3])!\n");
  347. end method;
  348.  
  349. define method tautology(arg == #"arrays")
  350.   let a = make(<array>, dimensions: #(4, 4));
  351.   (dimensions (a) = #(4, 4))
  352.     | signal("dimensions (a) are not #(4, 4)!  They're %=\n", dimensions (a));
  353.   (size(a) = 16)
  354.     | signal("size(a) is not 16!  It's %=\n", size(a));
  355.   for (i from 0 below 4)
  356.     for (j from 0 below 4)
  357.       a[i,j] := i * 4 + j;
  358.     end;
  359.   end;
  360.   (aref(a, 1, 1) = 5)
  361.     | signal("aref(a, 1, 1) is not 5! It's %=\n", aref(a, 1, 1));
  362.   (aref-setter(128, a, 1, 1) = 128)
  363.     | signal("aref-setter(128, a, 1, 1) is not 128! It's %=\n", aref-setter(128, a, 1, 1));
  364.   if (buggy?)
  365.     (rank(a) = 2)
  366.       | signal("rank(a) is not 2!  It's %=\n", rank(a));
  367.     //  Unbound variable: rank
  368.     (row-major-index(a, 1, 1) = 5)
  369.       | signal("row-major-index (a, 1, 1) is not 5!  It's %=\n", row-major-index(a, 1, 1));
  370.     //  Unbound variable: row-major-index
  371.     (dimension(a, 1) = 4)
  372.       | signal("dimension(a, 1) is not 4!  It's %=\n", dimension(a, 1));
  373.     //  Unbound variable: dimension
  374.   end;
  375. end method;
  376.  
  377. define method tautology(arg == #"deques")
  378.   let d = make(<deque>);
  379.   for (i from 5 to 1 by -1)
  380.     d := push(d, i);
  381.   end;
  382.   for (i from 6 to 10)
  383.     d := push-last(d, i);
  384.   end;
  385.   let p = pop(d);
  386.   (p = 1)
  387.     | signal("first pop(d) is not 1!  It's %=\n", p);
  388.   let p = pop-last(d);
  389.   (p = 10)
  390.     | signal("first pop-last(d) is not 10!  It's %=\n", p);
  391.   if (buggy?)
  392.     //  this should be the same as push() but is maybe push-last()
  393.     d := add!(d, 1);
  394.     let p = pop(d);
  395.     (p = 1)
  396.       | signal("second pop(d) is not 1!  It's %=\n", p);
  397.     //  this fails with a message about scan!()
  398.     d := remove!(d, 9);
  399.     let p = pop-last(d);
  400.     (p = 8)
  401.       | signal("second pop-last(d) is not 8!  It's %=\n", p);
  402.   end;
  403. end method;
  404.  
  405. define method tautology(arg == #"lists")
  406.   (pair(1, 2) = #(1 . 2))
  407.     | signal("pair(1, 2) is not #(1 . 2)!  It's %=\n", pair(1, 2));
  408.   (pair(1, #(2, 3, 4, 5)) = #(1, 2, 3, 4, 5))
  409.     | signal("pair(1, #(2, 3, 4, 5)) is not #(1, 2, 3, 4, 5)!  It's %=\n",
  410.          pair(1, #(2, 3, 4, 5)));
  411.   (list(1, 2, 3) = #(1, 2, 3))
  412.     | signal("list(1, 2, 3) is not #(1, 2, 3)!  It's %=\n", list (1, 2, 3));
  413.   (list(4 + 3, 4 - 3) =  #(7, 1))
  414.     | signal("list(4 + 3, 4 - 3) is not #(7, 1)!  It's %=\n", list (4 + 3, 4 - 3));
  415.   (head(#(4, 5, 6)) = 4)
  416.     | signal("head(#(4, 5, 6)) is not 4!  It's %=\n", head(#(4, 5, 6)));
  417.   (head(#()) = #())
  418.     | signal("head(#()) is not #()!  It's %=\n", head (#()));
  419.   (tail(#(4, 5, 6)) = #(5, 6))
  420.     | signal("tail (#(4, 5, 6)) is not #(5, 6)!  It's %=\n", tail (#(4, 5, 6)));
  421.   let x = list (4, 5, 6);
  422.   ((head(x) := 9) = 9)
  423.     | signal("(head(x) := 9) is not 9!\n");
  424.   (x = #(9, 5, 6))
  425.     | signal("x is not #(9, 5, 6)!  It's %=\n", x);
  426.   ((tail(x) := #(9, 8, 7)) = #(9, 8, 7))
  427.     | signal("(tail(x) := #(9, 8, 7)) is not #(9, 8, 7)!\n");
  428.   (x = #(9, 9, 8, 7))
  429.     | signal("x is not #(9, 9, 8, 7)!  It's %=\n", x);
  430.   let x = add!(x, 1);
  431.   (x = #(1, 9, 9, 8, 7))
  432.     | signal("x is not #(1, 9, 9, 8, 7)!  It's %=\n", x);
  433.   let x = remove!(x, 9);
  434.   (x = #(1, 8, 7))
  435.     | signal("x is not #(1, 8, 7)!  It's %=\n", x);
  436.   (size(x) = 3)
  437.     | signal("size(x) is not 3!  It's %=\n", size(x));
  438. end method;
  439.  
  440. define method tautology(arg == #"ranges")
  441.   let a = make(<range>, from: 0, to: 10);
  442.   let b = make(<range>, from: 5, to: 15);
  443.   (first(a) = 0)    | signal("first(a) is not 0! It's %=\n", first(a));
  444.   (first(b) = 5)    | signal("first(b) is not 5! It's %=\n", first(b));
  445.   (last(a) = 10)    | signal("last(a) is not 10! It's %=\n", last(a));
  446.   (last(b) = 15)    | signal("last(b) is not 15! It's %=\n", last(b));
  447.   member?(3, a)        | signal("member?(3, a) is not true!\n");
  448.   member?(12, a)    & signal("member?(12, a) is not false!\n");
  449.   member?(3, b)        & signal("member?(3, b) is not false!\n");
  450.   member?(12, b)    | signal("member?(12, b) is not true!\n");
  451.   (size(a) = 11)    | signal("size(a) is not 11!  It's %=\n", size(a));
  452.   (size(b) = 11)    | signal("size(b) is not 11!  It's %=\n", size(b));
  453.   let c = intersection(a, b);
  454.   (first(c) = 5)    | signal("first(c) is not 5!  It's %=\n", first(c));
  455.   (last(c) = 10)    | signal("last(c) is not 10!  It's %=\n", last(c));
  456.   member?(7, c)        | signal("member?(7, c) is not true!\n");
  457.   member?(12, c)    & signal("member?(12, c) is not false!\n");
  458.   (size(c) = 6)        | signal("size(c) is not 6!  It's %=\n", size(c));
  459.   let d = reverse(c);
  460.   (first(d) = 10)    | signal("first(d) is not 10!  It's %=\n", first(d));
  461.   (last(d) = 5)        | signal("last(d) is not 5!  It's %=\n", last(d));
  462.   let e = copy-sequence(d);
  463.   (d = e)        | signal("d is not equal to e!\n");
  464.   let f = reverse!(reverse!(d));
  465.   (d = f)        | signal("d is not equal to f!\n");
  466. end method;
  467.  
  468. define method tautology(arg == #"stretchy vectors")
  469.   let a = make(<stretchy-vector>);
  470. end method;
  471.  
  472. define method tautology(arg == #"strings")
  473.   let a = make(<byte-string>);
  474. end method;
  475.  
  476. define method tautology(arg == #"tables")
  477.   let a = make(<table>);
  478. end method;
  479.  
  480. define method tautology(arg == #"vectors")
  481.   let a = make(<vector>);
  482. end method;
  483.  
  484. define method tautology(arg :: <sequence>) => <integer>;
  485.   let warnings = 0;
  486.   local method warning(e :: <simple-warning>, next-handler)
  487.       apply(format, e.condition-format-string, e.condition-format-arguments);
  488.       warnings := warnings + 1;
  489.       #f;
  490.     end method;
  491.   let fatals = 0;
  492.   local method fatal(e :: <simple-error>, next-handler)
  493.       apply(format, e.condition-format-string, e.condition-format-arguments);
  494.       fatals := fatals + 1;
  495.       #f;
  496.     end method;
  497.   let handler <simple-warning> = warning;
  498.   for (arg in arg)
  499.     if (arg)
  500.       format("Tautologies on %s\n", as(<string>, arg));
  501.       tautology(arg);
  502.     end if;
  503.   end for;
  504.   format("Tautology completed with %d warnings and %d fatal errors\n", warnings, fatals);
  505.   warnings + fatals;
  506. end method;
  507.  
  508. define method main(argv0, #rest args)
  509.   if (empty?(args))
  510.     exit(exit-code: tautology(tautologies));
  511.   else
  512.     let args = map(curry(as, <symbol>), args);
  513.     if (every?(rcurry(member?, tautologies), args))
  514.       exit(exit-code: tautology(args));
  515.     else
  516.       format("usage: tautologies [package ...]\n");
  517.       for (arg in tautologies)
  518.         format("\t%s\n", as(<string>, arg));
  519.       end for;
  520.       exit(exit-code: -1);
  521.     end if;
  522.   end if;
  523. end method;
  524.